home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1991 / 01 / struc_p.asc < prev    next >
Text File  |  1990-12-07  |  12KB  |  376 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6. {---------------------------------------------------}
  7. {                    WHEN2.PAS                      }
  8. { A time-and-date stamp object for Turbo Pascal 6.0 }
  9. {                           by Jeff Duntemann       }
  10. {                           From DDJ for Jan. 1991  }
  11. { NOTE: This unit should be good until December 31, }
  12. { 2043, when the long integer time/date stamp turns }
  13. { negative.                                         }
  14. {---------------------------------------------------}
  15.  
  16. UNIT When2;
  17.  
  18. INTERFACE
  19.  
  20. USES DOS;
  21.  
  22. TYPE
  23.   String9  = STRING[9];
  24.   String20 = STRING[20];
  25.   String50 = STRING[50];
  26.  
  27.   When =
  28.     OBJECT
  29.       FUNCTION GetWhenStamp : LongInt;  { Returns 32-bit time/date stamp }
  30.       FUNCTION GetTimeStamp : Word;     { Returns DOS-format time stamp }
  31.       FUNCTION GetDateStamp : Word;     { Returns DOS-format date dtamp }
  32.       FUNCTION GetYear      : Word;
  33.       FUNCTION GetMonth     : Word;
  34.       FUNCTION GetDay       : Word;
  35.       FUNCTION GetDayOfWeek : Integer;  { 0=Sunday; 1=Monday, etc.  }
  36.       FUNCTION GetHours     : Word;
  37.       FUNCTION GetMinutes   : Word;
  38.       FUNCTION GetSeconds   : Word;
  39.       PROCEDURE PutNow;
  40.       PROCEDURE PutWhenStamp(NewWhen  : LongInt);
  41.       PROCEDURE PutTimeStamp(NewStamp : Word);
  42.       PROCEDURE PutDateStamp(NewStamp : Word);
  43.       PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : Word);
  44.       PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
  45.     PRIVATE
  46.       WhenStamp      : LongInt;      { Combined time/date stamp }
  47.       TimeString     : String9;      { i.e., "12:45a"           }
  48.       Hours,Minutes,Seconds : Word;  { Seconds is always even!  }
  49.       DateString     : String20;     { i.e., "06/29/89"         }
  50.       LongDateString : String50;     { i.e., "Thursday, June 29, 1989" }
  51.       Year,Month,Day : Word;
  52.       DayOfWeek      : Integer;      { 0=Sunday, 1=Monday, etc. }
  53.       FUNCTION  CalcTimeStamp : Word;
  54.       FUNCTION  CalcDateStamp : Word;
  55.       FUNCTION  CalcDayOfWeek : Integer;  { via Zeller's Congruence }
  56.       PROCEDURE CalcTimeString;
  57.       PROCEDURE CalcDateString;
  58.       PROCEDURE CalcLongDateString;
  59.     END;
  60.  
  61. IMPLEMENTATION
  62.  
  63. { Keep in mind that all this stuff is PRIVATE to the unit! }
  64.  
  65. CONST
  66.   MonthTags : ARRAY [1..12] of String9 =
  67.     ('January','February','March','April','May','June','July',
  68.      'August','September','October','November','December');
  69.   DayTags   : ARRAY [0..6] OF String9 =
  70.     ('Sunday','Monday','Tuesday','Wednesday',
  71.      'Thursday','Friday','Saturday');
  72.  
  73. TYPE
  74.   WhenUnion =
  75.     RECORD
  76.       TimePart : Word;
  77.       DatePart : Word;
  78.     END;
  79.  
  80. VAR
  81.   Temp1 : String50;
  82.   Dummy : Word;
  83.  
  84. {***********************************************}
  85. { PRIVATE method implementations for type When: }
  86. {***********************************************}
  87.  
  88. FUNCTION When.CalcTimeStamp : Word;
  89.  
  90. BEGIN
  91.   CalcTimeStamp := (Hours SHL 11) OR (Minutes SHL 5) OR (Seconds SHR 1);
  92. END;
  93.  
  94. FUNCTION When.CalcDateStamp : Word;
  95.  
  96. BEGIN
  97.   CalcDateStamp := ((Year - 1980) SHL 9) OR (Month SHL 5) OR Day;
  98. END;
  99.  
  100. PROCEDURE When.CalcTimeString;
  101.  
  102. VAR
  103.   Temp1,Temp2 : String9;
  104.   AMPM        : Char;
  105.   I           : Integer;
  106.  
  107. BEGIN
  108.   I := Hours;
  109.   IF Hours = 0 THEN I := 12;   { "0" hours = 12am }
  110.   IF Hours > 12 THEN I := Hours - 12;
  111.   IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a';
  112.   Str(I:2,Temp1); Str(Minutes,Temp2);
  113.   IF Length(Temp2) < 2 THEN Temp2 := '0' + Temp2;
  114.   TimeString := Temp1 + ':' + Temp2 + AMPM;
  115. END;
  116.  
  117. PROCEDURE When.CalcDateString;
  118.  
  119. BEGIN
  120.   Str(Month,DateString);
  121.   Str(Day,Temp1);
  122.   DateString := DateString + '/' + Temp1;
  123.   Str(Year,Temp1);
  124.   DateString := DateString + '/' + Copy(Temp1,3,2);
  125. END;
  126.  
  127. PROCEDURE When.CalcLongDateString;
  128.  
  129. VAR
  130.   Temp1 : String9;
  131.  
  132. BEGIN
  133.   LongDateString := DayTags[DayOfWeek] + ', ';
  134.   Str(Day,Temp1);
  135.   LongDateString := LongDateString +
  136.     MonthTags[Month] + ' ' + Temp1 + ', ';
  137.   Str(Year,Temp1);
  138.   LongDateString := LongDateString + Temp1;
  139. END;
  140.  
  141. FUNCTION When.CalcDayOfWeek : Integer;
  142.  
  143. VAR
  144.   Century,Holder : Integer;
  145.  
  146. FUNCTION Modulus(X,Y : Integer) : Integer;
  147.  
  148. VAR
  149.   R : Real;
  150.  
  151. BEGIN
  152.   R := X/Y;
  153.   IF R < 0 THEN
  154.     Modulus := X-(Y*Trunc(R-1))
  155.   ELSE
  156.     Modulus := X-(Y*Trunc(R));
  157. END;
  158.  
  159. BEGIN
  160.   { First test for error conditions on input values: }
  161.   IF (Year < 0)  OR
  162.      (Month < 1) OR (Month > 12) OR
  163.      (Day < 1)   OR (Day > 31) THEN
  164.      CalcDayOfWeek := -1  { Return -1 to indicate an error }
  165.   ELSE
  166.     { Do the Zeller's Congruence calculation as Zeller himself }
  167.     { described it in "Acta Mathematica" #7, Stockhold, 1887.  }
  168.     BEGIN
  169.       { First we separate out the year and the century figures: }
  170.       Century := Year DIV 100;
  171.       Year    := Year MOD 100;
  172.       { Next we adjust the month such that March remains month #3, }
  173.       {  but that January and February are months #13 and #14,     }
  174.       {  *but of the previous year*: }
  175.       IF Month < 3 THEN
  176.         BEGIN
  177.           Inc(Month,12);
  178.           IF Year > 0 THEN Dec(Year,1)      { The year before 2000 is }
  179.             ELSE                            { 1999, not 20-1...       }
  180.               BEGIN
  181.                 Year := 99;
  182.                 Dec(Century);
  183.               END
  184.         END;
  185.  
  186.       { Here's Zeller's seminal black magic: }
  187.       Holder := Day;                        { Start with the day of month }
  188.       Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
  189.       Holder := Holder + Year;              { Add in the year }
  190.       Holder := Holder + (Year DIV 4);      { Correct for leap years  }
  191.       Holder := Holder + (Century DIV 4);   { Correct for century years }
  192.       Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }
  193.  
  194.       Holder := Modulus(Holder,7);          { Take Holder modulus 7  }
  195.  
  196.       { Here we "wrap" Saturday around to be the last day: }
  197.       IF Holder  = 0 THEN Holder := 7;
  198.  
  199.       { Zeller kept the Sunday = 1 origin; computer weenies prefer to }
  200.       { start everything with 0, so here's a 20th century kludge:     }
  201.       Dec(Holder);
  202.  
  203.       CalcDayOfWeek := Holder;  { Return the end product! }
  204.     END;
  205. END;
  206.  
  207. {**********************************************}
  208. { PUBLIC method implementations for type When: }
  209. {**********************************************}
  210.  
  211. FUNCTION When.GetWhenStamp : LongInt;
  212.  
  213. BEGIN
  214.   GetWhenStamp := WhenStamp;
  215. END;
  216.  
  217. FUNCTION When.GetTimeStamp : Word;
  218.  
  219. BEGIN
  220.   GetTimeStamp := WhenUnion(WhenStamp).TimePart;
  221. END;
  222.  
  223. FUNCTION When.GetDateStamp : Word;
  224.  
  225. BEGIN
  226.   GetDateStamp := WhenUnion(WhenStamp).DatePart;
  227. END;
  228.  
  229. FUNCTION When.GetYear : Word;
  230.  
  231. BEGIN
  232.   GetYear := Year;
  233. END;
  234.  
  235. FUNCTION When.GetMonth : Word;
  236.  
  237. BEGIN
  238.   GetMonth := Month;
  239. END;
  240.  
  241. FUNCTION When.GetDay : Word;
  242.  
  243. BEGIN
  244.   GetDay := Day;
  245. END;
  246.  
  247. FUNCTION When.GetDayOfWeek : Integer;
  248.  
  249. BEGIN
  250.   GetDayOfWeek := DayOfWeek;
  251. END;
  252.  
  253. FUNCTION When.GetHours   : Word;
  254.  
  255. BEGIN
  256.   GetHours := Hours;
  257. END;
  258.  
  259. FUNCTION When.GetMinutes : Word;
  260.  
  261. BEGIN
  262.   GetMinutes := Minutes;
  263. END;
  264.  
  265. FUNCTION When.GetSeconds : Word;
  266.  
  267. BEGIN
  268.   GetSeconds := Seconds;
  269. END;
  270.  
  271. {---------------------------------------------------------------------}
  272. { To fill a When record with the current time and date as maintained  }
  273. { by the system clock, execute this method:                           }
  274. {---------------------------------------------------------------------}
  275.  
  276. PROCEDURE When.PutNow;
  277.  
  278. BEGIN
  279.   { Get current clock time.  Note that we ignore hundredths figure: }
  280.   GetTime(Hours,Minutes,Seconds,Dummy);
  281.   { Calculate a new time stamp and update object fields: }
  282.   PutTimeStamp(CalcTimeStamp);
  283.   GetDate(Year,Month,Day,Dummy); { Get current clock date }
  284.   { Calculate a new date stamp and update object fields: }
  285.   PutDateStamp(CalcDateStamp);
  286. END;
  287.  
  288. {---------------------------------------------------------------------}
  289. { This method allows us to apply a whole long integer time/date stamp }
  290. { such as that returned by the DOS unit's GetFTime procedure to the   }
  291. { When object.  The object divides the stamp into time and date       }
  292. { portions and recalculates all other fields in the object.           }
  293. {---------------------------------------------------------------------}
  294.  
  295. PROCEDURE When.PutWhenStamp(NewWhen  : LongInt);
  296.  
  297. BEGIN
  298.   WhenStamp := NewWhen;
  299.   { We've actually updated the stamp proper, but we use the two }
  300.   { "put" routines for time and date to generate the individual }
  301.   { field and string representation forms of the time and date. }
  302.   { I know that the "put" routines also update the long integer }
  303.   { stamp, but while unnecessary it does no harm.               }
  304.   PutTimeStamp(WhenUnion(WhenStamp).TimePart);
  305.   PutDateStamp(WhenUnion(WhenStamp).DatePart);
  306. END;
  307.  
  308. {---------------------------------------------------------------------}
  309. { We can choose to update only the time stamp, and the object will    }
  310. { recalculate only its time-related fields.                           }
  311. {---------------------------------------------------------------------}
  312.  
  313. PROCEDURE When.PutTimeStamp(NewStamp : Word);
  314.  
  315. BEGIN
  316.   WhenUnion(WhenStamp).TimePart := NewStamp;
  317.   { The time stamp is actually a bitfield, and all this shifting left }
  318.   { and right is just extracting the individual fields from the stamp:}
  319.   Hours := NewStamp SHR 11;
  320.   Minutes := (NewStamp SHR 5) AND $003F;
  321.   Seconds := (NewStamp SHL 1) AND $001F;
  322.   { Derive a string version of the time: }
  323.   CalcTimeString;
  324. END;
  325.  
  326. {---------------------------------------------------------------------}
  327. { Or, we can choose to update only the date stamp, and the object     }
  328. { will then recalculate only its date-related fields.                 }
  329. {---------------------------------------------------------------------}
  330.  
  331. PROCEDURE When.PutDateStamp(NewStamp : Word);
  332.  
  333. BEGIN
  334.   WhenUnion(WhenStamp).DatePart := NewStamp;
  335.   { Again, the date stamp is a bit field and we shift the values out  }
  336.   { of it: }
  337.   Year := (NewStamp SHR 9) + 1980;
  338.   Month := (NewStamp SHR 5) AND $000F;
  339.   Day := NewStamp AND $001F;
  340.   { Calculate the day of the week value using Zeller's Congruence:    }
  341.   DayOfWeek := CalcDayOfWeek;
  342.   { Calculate the short string version of the date; as in "06/29/89": }
  343.   CalcDateString;
  344.   { Calculate a long version, as in "Thursday, June 29, 1989": }
  345.   CalcLongDateString;
  346. END;
  347.  
  348. PROCEDURE When.PutNewDate(NewYear,NewMonth,NewDay : Word);
  349.  
  350. BEGIN
  351.   { The "boss" field is the date stamp.  Everything else is figured }
  352.   { from the stamp, so first generate a new date stamp, and then    }
  353.   { (odd as it may seem) regenerate everything else, *including*    }
  354.   { the Year, Month, and Day fields: }
  355.   PutDateStamp(CalcDateStamp);
  356.   { Calculate the short string version of the date; as in "06/29/89": }
  357.   CalcDateString;
  358.   { Calculate a long version, as in "Thursday, June 29, 1989": }
  359.   CalcLongDateString;
  360. END;
  361.  
  362. PROCEDURE When.PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
  363.  
  364. BEGIN
  365.   { The "boss" field is the time stamp.  Everything else is figured }
  366.   { from the stamp, so first generate a new time stamp, and then    }
  367.   { (odd as it may seem) regenerate everything else, *including*    }
  368.   { the Hours, Minutes, and Seconds fields: }
  369.   PutTimeStamp(CalcTimeStamp);
  370.   { Derive the string version of the time: }
  371.   CalcTimeString;
  372. END;
  373.  
  374. END.
  375.  
  376.